home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / ibm_pc_d.exe / SAMPLES / RANDOM.P < prev    next >
Text File  |  1992-11-06  |  18KB  |  563 lines
  1. SYSTEM Evaluation_of_Random_Stereo_Images ;                  (* Version 1.0 *)
  2.  
  3. (* Using the method which is described in an article about LISP:            *)
  4. (*    Compute the number of hits in a rectangle. The plain with the         *)
  5. (*    most hits for a certain Pixel get the preference                      *)
  6.  
  7. TYPE
  8.  string = ARRAY [ 200 ] OF CHAR ;
  9.  
  10. CONST 
  11.  maxWidth  = 128 ;           (* maximal width of input image                *)
  12.  maxHeigth = 128 ;           (* maximal heigth of input image               *)
  13.  maxDepth  = 4   ;           (* depth of computation                        *)
  14.  
  15. CONFIGURATION 
  16.  pict [ 1 .. maxHeigth ] , [ 1 .. maxWidth ] ;
  17.  
  18. CONNECTION    
  19.  left_port : pict [ i,j ] <-> pict [ i  ,j-1 ].right_port ;
  20.  up_port   : pict [ i,j ] <-> pict [ i-1,j   ].down_port  ;
  21.  
  22. SCALAR
  23.  LeftPicture ,
  24.  RightPicture  : ARRAY [ 1 .. maxHeigth ], [ 1 .. maxWidth ] OF INTEGER ; 
  25.                              (* Memory for left and right image             *)
  26.  
  27.  Picture       : ARRAY [ 1 .. maxHeigth ] , [ 1 .. maxWidth ] OF CHAR ;
  28.  i , j ,                     (* counter                                     *)
  29.  ToleranceLimit,             (* decides if a Pixel belongs to current plane *)
  30.  Shifts,                     (* for calculating sum                         *)
  31.  PicHeigth,                  (* heigth of input image                       *)
  32.  PicWidth      : INTEGER ;   (* width of input image                        *)
  33.  Answer,                     (* for input from console                      *)
  34.  Inputfile,
  35.  FileName      : string  ;   (* name of Inputfile                           *)
  36.  Batch         : BOOLEAN ;   (* flag for Batchmode                          *)
  37.  
  38. VECTOR
  39.  Pixel         : ARRAY [ 1 .. maxDepth ] OF INTEGER ;  
  40.                              (* memory for each image plane                 *)
  41.  
  42.  Left,                       (* Pixel of left image                         *)
  43.  Right         : INTEGER ;   (* Pixel of right image                        *)
  44.  pic           : CHAR    ;
  45.        
  46.  
  47. (************************* STRCAT *******************************************)
  48. (* catenation of two strings                                                *)
  49.  
  50. PROCEDURE strcat( SCALAR first , second : string ) : SCALAR string ;
  51.  
  52.  SCALAR
  53.   i , j : INTEGER ;
  54.  
  55.  BEGIN          
  56.   i := 0 ; j := 0 ;
  57.   WHILE first[i]  <> CHR(0) DO INC(i) ; END ;
  58.   WHILE second[j] <> CHR(0) DO 
  59.     first[i] := second[j] ; 
  60.     INC(j) ; INC(i) ; 
  61.   END ;
  62.   first[i] := CHR(0) ;
  63.  
  64.   RETURN first ;
  65.  END strcat ;
  66.  
  67. (************************** READPICTURE *************************************)
  68. (* reading random image                                                     *)
  69.  
  70. PROCEDURE ReadPicture() : SCALAR BOOLEAN ;  
  71.                 
  72.  VECTOR  
  73.   tmp            : INTEGER;
  74.  
  75.  SCALAR               
  76.   Character      : CHAR ;
  77.   Heigth, Width  : INTEGER ;
  78.   XPos, YPos     : INTEGER ;
  79.   DeltaX, DeltaY : INTEGER ;
  80.   XIndex, YIndex : INTEGER ;
  81.   magic          : string ;
  82.   color          : INTEGER ;
  83.  
  84.  BEGIN
  85.   PicHeigth := maxHeigth ; 
  86.   PicWidth  := maxWidth ;
  87.    
  88.   IF NOT Batch THEN
  89.     WriteString( "Inputfile (without extension '.l.ppm' and '.r.ppm') : " ) ;
  90.                               (* requesting Filename *)
  91.     ReadString( Inputfile ) ;
  92.    ELSE
  93.     Inputfile := "batch" ;
  94.   END ; (* IF *)
  95.  
  96.   FileName := strcat( Inputfile , ".l.ppm" ) ;
  97.   OpenInput( FileName ) ;     (* open File *)
  98.   IF Done THEN
  99.     ReadString( magic ) ;
  100.     ReadInt( Width ) ;        (* reading Heigth and Width of image *)
  101.     ReadInt( Heigth ) ;    
  102.     CloseInput ;
  103.  
  104.     IF Heigth < PicHeigth THEN
  105.      PicHeigth := Heigth ;
  106.     END ; (* IF *)
  107.     
  108.     IF Width < PicWidth THEN
  109.      PicWidth := Width ;
  110.     END ; (* IF *)
  111.     
  112.     IF (Heigth > PicHeigth) OR ( Width > PicWidth ) THEN
  113.      IF Batch THEN
  114.        DeltaX := -5 ;
  115.       ELSE 
  116.        WriteString( "Image too large. Please enter Image-region : " ) ;
  117.        ReadInt( DeltaX ) ;
  118.      END ;
  119.  
  120.      IF DeltaX >= 0 THEN
  121.        WriteString( "Y-Relocation : " ) ;
  122.        ReadInt( DeltaY ) ;
  123.        DeltaY := ABS( DeltaY ) ;
  124.        IF (Width - PicWidth) < DeltaX THEN
  125.         DeltaX :=  Width - PicWidth ;
  126.        END ; 
  127.        IF (Heigth - PicHeigth) < DeltaY THEN
  128.         DeltaY :=  Heigth - PicHeigth ;
  129.        END ;
  130.       ELSE                    (* Delta negativ : using default region *)
  131.        CASE ABS( DeltaX ) OF
  132.          1 :  DeltaX := 0                         ; DeltaY :=  Heigth - PicHeigth ; |
  133.          2 :  DeltaX := (Width - PicWidth ) DIV 2 ; DeltaY :=  Heigth - PicHeigth ; |
  134.          3 :  DeltaX :=  Width - PicWidth         ; DeltaY :=  Heigth - PicHeigth ; |
  135.          4 :  DeltaX := 0                         ; DeltaY := (Heigth - PicHeigth) DIV 2 ; |
  136.          5 :  DeltaX := (Width - PicWidth ) DIV 2 ; DeltaY := (Heigth - PicHeigth) DIV 2 ; |
  137.          6 :  DeltaX :=  Width - PicWidth         ; DeltaY := (Heigth - PicHeigth) DIV 2 ; |
  138.          7 :  DeltaX := 0                         ; DeltaY := 0 ; |
  139.          8 :  DeltaX := (Width - PicWidth ) DIV 2 ; DeltaY := 0 ; |
  140.          9 :  DeltaX :=  Width - PicWidth         ; DeltaY := 0 ;
  141.         ELSE
  142.          WriteString("Incorrect region.") ; WriteLn ;
  143.          RETURN FALSE ;
  144.        END ; (* CASE ABS(DeltaX) *)
  145.      END ; (* IF DeltaX >= 0 *) 
  146.     ELSE
  147.      DeltaX := 0 ; DeltaY := 0 ;
  148.     END ; (* IF (Heigth.. *)
  149.     
  150.     PARALLEL
  151.       tmp := 0;
  152.     ENDPARALLEL;
  153.  
  154.     STORE (tmp, LeftPicture);
  155.     STORE (tmp, RightPicture);
  156.  
  157.     OpenInput( FileName ) ;
  158.     ReadString( magic ) ;
  159.     ReadInt( Width ) ;  Read( Character ) ;           (* read Linefeed *)
  160.     ReadInt( Heigth ) ; Read( Character ) ;           (* read Linefeed *)
  161.     ReadInt( color ); Read( Character ) ;
  162.  
  163.     WriteString( "Reading left image ..." ) ; 
  164.     WriteLn ;
  165.  
  166.     XIndex := 1;
  167.     YIndex := 1;
  168.     FOR YPos := 1 TO Heigth DO
  169.      FOR XPos := 1 TO Width DO
  170.       Read( Character ) ;
  171.       Read( Character ) ;
  172.       Read( Character ) ;
  173.       IF (DeltaY < YPos <= (DeltaY+PicHeigth)) AND    (* check image region *)
  174.          (DeltaX < XPos <= (DeltaX+PicWidth)) THEN
  175.         LeftPicture[YPos - DeltaY][XPos - DeltaX] := ORD( Character ) ;
  176.       END ; (* IF *)
  177.      END ; (* FOR *)
  178.     END ; (* FOR *) 
  179.  
  180.     FileName := strcat( Inputfile , ".r.ppm" ) ;
  181.     OpenInput( FileName ) ;
  182.     ReadString( magic ) ;
  183.     ReadInt( Width )  ; Read( Character ) ;           (* read Linefeed *)
  184.     ReadInt( Heigth ) ; Read( Character ) ;           (* read Linefeed *)
  185.     ReadInt( color ); Read( Character ) ;
  186.  
  187.     WriteString( "Reading right image ..." ) ; 
  188.     WriteLn ;
  189.  
  190.     FOR YPos := 1 TO Heigth DO
  191.      FOR XPos := 1 TO Width DO
  192.       Read( Character ) ;
  193.       Read( Character ) ;
  194.       Read( Character ) ;
  195.       IF (DeltaY < YPos <= (DeltaY+PicHeigth)) AND    (* check image region *)
  196.          (DeltaX < XPos <= (DeltaX+PicWidth)) THEN
  197.         IF ( XIndex = maxWidth ) THEN
  198.           XIndex := 0; INC( YIndex );
  199.         ELSE
  200.           INC( XIndex );
  201.         END;
  202.         RightPicture[ YPos - DeltaY ][ XPos - DeltaX ] := ORD( Character ) ;
  203.       END ; (* IF *)
  204.      END ; (* FOR *)
  205.     END ; (* FOR *)
  206.  
  207.     RETURN TRUE ;
  208.  
  209.    ELSE            
  210.     WriteString( "File not found." ) ; WriteLn ;
  211.     RETURN FALSE ;
  212.   END ;(* IF Done *)
  213.  END ReadPicture ;
  214.  
  215. (************************** PARALLELSUM *************************************)
  216. (* This function counts how many marked Pixel (value = '1') surrounds the   *)
  217. (* Pixel, which is in the center of a square with edge length 2*Shifts+1.   *)
  218. (* Shifts is a global variable for setting square size                      *)
  219.  
  220. PROCEDURE Parallelsum( VECTOR my_number : INTEGER ) : VECTOR INTEGER ;
  221.  
  222.  SCALAR
  223.    i : INTEGER ;                  (* counter *)
  224.      
  225.  VECTOR  
  226.    sum,                           (* quantity of marked Pixel surrounding a Pixel *)
  227.    shift_number1,
  228.    shift_number2 : INTEGER ;      (* number which is sending to the neighbour  *)
  229.  
  230.  BEGIN
  231.   sum            := my_number ;   (* number of myself *)
  232.   shift_number1  := my_number ;
  233.   shift_number2  := my_number ;
  234.  
  235.   FOR i := 1 TO Shifts DO                  
  236.    PROPAGATE .right_port( shift_number1 ) ; 
  237.                                   (* sending pixelvalue to the right        *)
  238.    PROPAGATE .left_port( shift_number2 ) ;       
  239.                                   (* sending pixelvalue to the left         *)
  240.    sum := sum + shift_number1 + shift_number2 ;  
  241.   END ;
  242.  
  243.   my_number     := sum ;          (* store of calculated horizontal sum     *)
  244.   shift_number1 := my_number ;    (* and sending above and below            *)
  245.   shift_number2 := my_number ;
  246.  
  247.   FOR i := 1 TO Shifts DO
  248.    PROPAGATE .up_port( shift_number1 ) ;        (* sending above            *)
  249.    PROPAGATE .down_port( shift_number2 ) ;      (* sending below            *)
  250.    sum := sum + shift_number1 + shift_number2 ; 
  251.   END ;
  252.  
  253.   RETURN sum ;                    (* sum contains now the sum of marked     *)
  254.                                   (* Pixel (value = '1') in the square      *)
  255.  END Parallelsum ;
  256.  
  257. (************************** Show_Plains *************************************)
  258. (* This procedure display the results of each image-plain for possible      *)
  259. (* viewing after each calculating step                                      *)
  260.  
  261. PROCEDURE Show_Plains ;
  262.  
  263.  SCALAR
  264.   plain, x, y : INTEGER ;
  265.  
  266.  BEGIN
  267.   IF NOT Batch THEN
  268.    REPEAT           
  269.     WriteString( "Which plain do you want to see ? ( 1 .. ");
  270.     WriteInt( maxDepth , 1 ) ;
  271.     WriteString(" , 0 = no plain ) : ") ;
  272.     ReadInt( plain ) ;
  273.     IF 1 <= plain <= maxDepth THEN
  274.      PARALLEL
  275.       pic := CHR(0);
  276.      ENDPARALLEL;
  277.  
  278.      PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ] 
  279.       pic := CHR(Pixel[ plain ]+ORD('0'));
  280.      ENDPARALLEL ;
  281.  
  282.      STORE( pic , Picture ) ;
  283.  
  284.      WriteString("Image Plain : ") ; WriteInt( plain , 1 ) ; WriteLn ;
  285.      FOR y := 1 TO PicHeigth DO
  286.       WriteString( Picture[y] ) ;
  287.       WriteLn ;
  288.      END ; (* FOR y *)
  289.      WriteLn ;  
  290.     END ; (* IF 1 <= plain .. *)
  291.    UNTIL plain = 0 ;
  292.   END ; (* IF NOT Batch *)
  293.  
  294.  END Show_Plains ;
  295.      
  296. (************************** Show_All ****************************************)
  297. (* This procedure display the results of all image plains                   *)
  298.  
  299. PROCEDURE Show_All ;
  300.  
  301.  SCALAR
  302.   plain,
  303.   x, y   : INTEGER ;
  304.  
  305.  VECTOR
  306.   Heigth : INTEGER ;
  307.  
  308.  BEGIN
  309.   PARALLEL
  310.    pic := CHR (0);
  311.   ENDPARALLEL;
  312.  
  313.   PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ] 
  314.    FOR plain := 1 TO maxDepth DO          (* to which plain belongs a plain *)
  315.     IF Pixel[ plain ] = 1 THEN
  316.      Heigth := plain ;
  317.     END ; (* IF Pixel[plain] = 1 *)
  318.    END ; (* FOR *)
  319.    pic := CHR(Heigth+ORD('0')-1);
  320.   ENDPARALLEL ;
  321.  
  322.   IF NOT Batch THEN
  323.    STORE( pic , Picture ) ;
  324.    FOR y := 1 TO PicHeigth DO
  325.     WriteString( Picture[y] ) ;
  326.     WriteLn ;
  327.    END ; (* FOR y *)
  328.    WriteLn ;  
  329.   END ; (* IF NOT Batch *)
  330.  
  331.  END Show_All ;
  332.  
  333. (************************** Common_Elements *********************************)
  334. (* The vectors Left and Right contains in the beginning both images in the  *)
  335. (* right position against one another. If both pixel have the same value,   *)
  336. (* then it would be marked by storing 1 in Pixel[ plain ]. Afterwards the   *)
  337. (* left image would be shifted left by one pixel and searched again for     *)
  338. (* common elements with the right image. This repeats until maxDepht is     *)
  339. (* reached                                                                  *)  
  340.  
  341. PROCEDURE Common_Elements ;
  342.  
  343.  SCALAR
  344.    plain  : INTEGER ;
  345.  
  346.  BEGIN
  347.   PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ]
  348.    FOR plain := 1 TO maxDepth DO   (* for each image plain *)
  349.     Pixel[plain] := 0 ;            (* different Pixel      *)
  350.     IF Left = Right THEN
  351.       Pixel[plain] := 1 ;          (* equal Pixel *)
  352.     END ;
  353.     
  354.     PROPAGATE .left_port(Left) ;   (* shifting left image one position to the left *)
  355.  
  356.    END ;     
  357.   ENDPARALLEL ;          
  358.  
  359.  END Common_Elements ;
  360.    
  361. (************************** Search_Objects **********************************)
  362. (* For almost each pixel it exists some possible plains. By comparing with  *)
  363. (* neighbour-pixels it can be find out to which plain a pixel belongs.      *)
  364.  
  365. PROCEDURE Search_Objects ;
  366.  
  367.  SCALAR
  368.    plain      : INTEGER ;
  369.  
  370.  VECTOR
  371.    max, 
  372.    maxpos, 
  373.    Pixelsum : INTEGER ;
  374.  
  375.  BEGIN
  376.   PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ]
  377.    max := 0 ; maxpos := 1 ;
  378.    FOR plain := 1 TO maxDepth DO   (* for each image plain *)
  379.     Pixelsum := Parallelsum( Pixel[plain] ) ; 
  380.                                    (* calculating sum of surrounding p *)
  381.  
  382.     IF (Pixel[ plain ] = 1) AND (Pixelsum > max) THEN 
  383.                                    (* if new maximum found *)
  384.  
  385.      maxpos := plain ;             (* store current plain *)
  386.      max    := Pixelsum ;          (* store maximum *)
  387.     END ; (* IF Pixelsum *)
  388.     Pixel[ plain ] := 0 ;          (* delete plain *)
  389.    END ; (* FOR plain *)
  390.    Pixel[ maxpos ] := 1 ;          (* mark found plain with 1 *)
  391.   ENDPARALLEL ;
  392.  
  393.  END Search_Objects ;
  394.  
  395.  
  396. (************************** FILTER ******************************************)
  397. (* It's possible, that some few pixel would not be correct calculated.      *)
  398. (* The procedure Filter has to search for these pixels and then assign      *)
  399. (* to a suitable plain.                                                     *)
  400.  
  401. PROCEDURE Filter ;
  402.  
  403.  SCALAR
  404.    plain      : INTEGER ;
  405.  
  406.  VECTOR
  407.    max, 
  408.    maxpos, 
  409.    Pixelsum : INTEGER ;
  410.    change   : BOOLEAN ;
  411.  
  412.  BEGIN
  413.   PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ]
  414.    max := 0 ; change := FALSE ;
  415.    FOR plain := 1 TO maxDepth DO                   (* for each image plain  *)
  416.     Pixelsum := Parallelsum( Pixel[plain] ) ;      (* look at neighbourhood *)
  417.     IF Pixelsum > max THEN
  418.       max    := Pixelsum ;                 (* store the propably best plain *)
  419.       maxpos := plain ;                                
  420.     END ; (* IF Pixelsum *)
  421.  
  422.     IF ( Pixel[plain] = 1 ) AND ( Pixelsum <= ToleranceLimit ) THEN  
  423.                                                          (* 'lost pixel' ?? *)
  424.      Pixel[plain] := 0 ; 
  425.      change      := TRUE ;
  426.     END ; (* IF Pixel[ plain ] *)
  427.  
  428.    END ; (* FOR plain *)
  429.  
  430.    IF change THEN
  431.     Pixel[maxpos] := 1 ;                    (* 'lost pixel' get a new plain *)
  432.    END ; (* IF change *)
  433.  
  434.   ENDPARALLEL ;
  435.  
  436.  END Filter ;
  437.  
  438.  
  439. (************************* PPM_Output  **************************************)
  440. (* saving the resulting image, File Format is PPM                           *)
  441.  
  442. PROCEDURE PPM_Output ; 
  443.  
  444.  SCALAR
  445.   i, j, plain  : INTEGER ;
  446.  
  447.  VECTOR
  448.   Heigth       : INTEGER ;
  449.  
  450.  BEGIN
  451.   PARALLEL
  452.    Heigth := 0;
  453.   ENDPARALLEL;
  454.  
  455.   PARALLEL [ 1 .. PicHeigth ] , [ 1 .. PicWidth ] 
  456.    FOR plain := 1 TO maxDepth DO          (* to which plain belongs a pixel *)
  457.     IF Pixel[ plain ] = 1 THEN
  458.      Heigth := plain ;
  459.     END ; (* IF Pixel[plain] = 1 *)
  460.    END ; (* FOR *)
  461.    pic := CHR( Heigth+ORD('0')-1 );
  462.   ENDPARALLEL ;
  463.  
  464.   STORE( Heigth , LeftPicture ) ;
  465.  
  466.   OpenOutput( FileName ) ; 
  467.  
  468.   WriteString( "P6" ) ; WriteLn ;        (* RAWBIT option, not ASCII *)
  469.  
  470.   WriteInt( PicWidth, 1 ) ; WriteLn ;
  471.   WriteInt( PicHeigth, 1  ) ; WriteLn ;
  472.  
  473.   WriteInt( maxDepth, 1 ) ; WriteLn ;    (* maximum color-component value *)
  474.  
  475.   FOR i := 1 TO PicHeigth DO
  476.    FOR j := 1 TO PicWidth DO             (* saving pixel: *)
  477.     Write( CHR( LeftPicture[i,j] )) ;    (* red value     *)
  478.     Write( CHR( LeftPicture[i,j] )) ;    (* green value   *)
  479.     Write( CHR( LeftPicture[i,j] )) ;    (* blue value    *)
  480.    END ; (* FOR j *)                     
  481.   END ; (* FOR i *)
  482.  
  483.   CloseOutput ;
  484.  END PPM_Output ;
  485.  
  486.  
  487. (************************** Main Program ************************************)
  488.  
  489. SCALAR 
  490.  c : CHAR;
  491.  
  492. BEGIN                                    
  493.  OpenInput( "Batch" ) ;
  494.  
  495.  IF Done THEN
  496.    Batch := TRUE ; WriteString( "Program in Batch-Mode ..." ) ; WriteLn ;
  497.   ELSE
  498.    Batch := FALSE ;
  499.   END ;
  500.  CloseInput ;
  501.  
  502.  IF ReadPicture() = FALSE THEN
  503.   WriteString("###### Program terminated abnormaly ######" ) ; 
  504.   WriteLn ; HALT ;
  505.  END ;       
  506.        
  507.  CloseInput ;                 (* return to input from console *)
  508.  
  509. (* explore both images :                                                    *)
  510. (* first both images would be put one upon the other und extract common     *)
  511. (* elements. Then one image would be shifted and compared again with the    *)
  512. (* other and so on.                                                         *)
  513.  
  514.    LOAD( Left  , LeftPicture  ) ;
  515.    LOAD( Right , RightPicture ) ; 
  516.  
  517.  WriteString( "Examine left an right image for common elements ...") ; 
  518.  WriteLn ;
  519.  
  520.  Common_Elements ;
  521.  
  522.  Show_Plains ;
  523.  
  524.  WriteString("Discovering objects in each plain ...") ; WriteLn ;
  525.                                          
  526.  Shifts := 2 ;               (* Neighbourhood with 5x5 = 25 Pixel *)
  527.  Search_Objects ;            (* find for each pixel the right plain *)
  528.  
  529.  Show_Plains ;
  530.  Show_All  ;
  531.  
  532.  Shifts := 1 ;               (* Neighbourhood with 3x3 = 9 Pixel *)
  533.  ToleranceLimit := 4 ;
  534.  
  535.  WriteString("Filter ...") ; WriteLn ;
  536.  IF NOT Batch THEN
  537.    REPEAT 
  538.     Filter ;
  539.     Show_Plains ;
  540.     Show_All ; 
  541.     WriteString("Filter again (y/n) ? ") ; ReadString( Answer ) ;
  542.    UNTIL Answer[0] <> 'y' ;               
  543.   ELSE
  544.    Filter ;
  545.    Filter ;
  546.    Show_All ;
  547.  END ; (* IF NOT Batch *)
  548.  
  549.  FileName := strcat( Inputfile , ".out.ppm" ) ;
  550.  
  551.  WriteString( "Saving resulting image as '") ;
  552.  WriteString( FileName ) ;
  553.  WriteString( "' ..." ) ; WriteLn ;
  554.            
  555.  
  556.  
  557.  PPM_Output;
  558.  
  559.  CloseInput ;
  560.  
  561. END Evaluation_of_Random_Stereo_Images.
  562.  
  563.